home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vbxs / vbtrace / vbtrace.bas < prev    next >
Encoding:
BASIC Source File  |  1996-04-08  |  7.7 KB  |  226 lines
  1.    Option Explicit
  2.    DefInt A-Z
  3.                
  4. '--TIMER FUNCTION
  5.    Declare Function CMS_TimeGetTime Lib "MMSystem" Alias "TimeGetTime" () As Long
  6.  
  7. '--FUNCTION TO SEE IF VBTRACE IS RUNNING
  8.    Declare Function CMS_FindWindow Lib "User" Alias "FindWindow" (ByVal ThunderForm As Any, ByVal lpCaption As Any)
  9.  
  10. '--INI FILES
  11.    Declare Function CMS_GetPrivateProfileString Lib "Kernel" Alias "GetPrivateProfileString" (ByVal Appname As String, ByVal KeyName As String, ByVal DEFAULT As String, ByVal ReturnedString As String, ByVal MaxSize, ByVal Filename As String)
  12.  
  13. '--GET FREE GDI AND USR MEMORY
  14.    Declare Function CMS_GetFreeSystemResources Lib "User" Alias "GetFreeSystemResources" (ByVal fuSysResource)
  15.    Global Const GDI = 1
  16.    Global Const USR = 2
  17.  
  18. '--GET SYSTEM MEMORY
  19.    Declare Function CMS_GetFreeSpace Lib "Kernel" Alias "GetFreeSpace" (ByVal wFlags) As Long
  20.  
  21. '--FREE DISK SPACE
  22.    Declare Function CMS_DiskSpaceFree Lib "SetupKit.DLL" Alias "DiskSpaceFree" () As Long
  23.  
  24. Sub VBTrace (OpCode, ProcedureName As String)
  25.  
  26. '--DECLARE VARIABLES
  27.    Dim I, J
  28.    Dim Result
  29.    Dim FL As Long
  30.    Dim SyncCode As String
  31.    Dim ThisTime As Long
  32.    Dim OutRecord As String
  33.    Dim TraceGridVariable As String
  34.    Dim ElapsedTime As String
  35.    Dim CumlativeTime As String
  36.    Dim TotalTime As String
  37.    Dim Percent As String
  38.    Dim Msg As String
  39.    Dim ppFileName As String
  40.    Dim ppValue As String
  41.  
  42. '--DECLARE CONSTANTS
  43.    Const IconStop = 16
  44.    Const ThisProgramsSyncCode = ""
  45.    Const TraceFileRecordLength = 600
  46.    Const ppTitle = "VBTrace Grid Column Configuration"
  47.    Const ppItem = "SyncCode"
  48.    Const ppDefault = ""
  49.    Const Padder = "."
  50.  
  51. '--DECLARE STATIC VARIABLES
  52.    Static TraceOperationOffSwitch
  53.    Static PreviousLine()
  54.    Static PreviousTime() As Long
  55.    Static CumTime() As Long
  56.    Static PercentTime()
  57.    Static TotalRunTime As Long
  58.    Static EntryCount()
  59.    Static ExitCount()
  60.    Static LineNumber
  61.    Static ProcedureNames() As String
  62.    Static PreviousProcedure As String
  63.    Static PreviousOpCode
  64.    Static MarginWidth
  65.    Static VBTraceFileNo
  66.    
  67. '--IF TRACE HAS BEEN TURNED OFF THEN EXIT
  68.    If TraceOperationOffSwitch Then
  69.       Exit Sub
  70.    ElseIf CMS_FindWindow(0&, "VBTrace 2.0  -  Visual Basic Debug Utility") Then
  71.    ElseIf CMS_FindWindow(0&, "VBTrace") Then
  72.    Else
  73.       Exit Sub
  74.    End If
  75.  
  76. '--GET ARBAY SIZE AND BUMP IF NECESSARY
  77.    ReDim EntryExit(1) As String
  78.    EntryExit(0) = "(Entry)"
  79.    EntryExit(1) = "(Exit)"
  80.    On Error Resume Next
  81.    For I = 0 To UBound(ProcedureNames)
  82.       If ProcedureName = ProcedureNames(I) Then
  83.          Exit For
  84.       End If
  85.    Next I
  86.    If I > UBound(ProcedureNames) Then
  87.       ReDim Preserve ProcedureNames(I + 100)
  88.       ReDim Preserve CumTime(I + 100)
  89.       ReDim Preserve PercentTime(I + 100)
  90.       ReDim Preserve EntryCount(I + 100)
  91.       ReDim Preserve ExitCount(I + 100)
  92.       ReDim Preserve PreviousLine(-1 To I + 100)
  93.       ReDim Preserve PreviousTime(-1 To I + 100)
  94.       ProcedureNames(I) = ProcedureName
  95.    End If
  96.    
  97. '--SET INDENT
  98.    Select Case OpCode
  99.       Case 1         'ENTERED PROCEDURE
  100.          EntryCount(I) = EntryCount(I) + 1
  101.          If PreviousOpCode = 1 Then
  102.             MarginWidth = MarginWidth + 2
  103.          End If
  104.       Case 2         'EXITED PROCEDURE
  105.          ExitCount(I) = ExitCount(I) + 1
  106.          If ProcedureName <> PreviousProcedure Then
  107.             MarginWidth = MarginWidth - 2
  108.          End If
  109.    End Select
  110.          
  111. '--GET SYNCCODE IF FIRST LINE
  112.    ppValue = Space$(199)
  113.    Result = CMS_GetPrivateProfileString(ppTitle, ppItem, ppDefault, ppValue, Len(ppValue) + 1, app.Path & "\VBTRACE.INI")
  114.    SyncCode = Trim$(ppValue)
  115.    If SyncCode <> ThisProgramsSyncCode & Chr$(0) Then
  116.       Msg = "The VBTrace Column Configuration Has Changed Since This Program "
  117.       Msg = Msg & "Was Loaded.  You Must Exit And Reload This Program."
  118.       MsgBox Msg, IconStop, "VBTrace Error Message"
  119.       Close
  120.       End
  121.    End If
  122.    On Error Resume Next
  123.    FL = FileLen(app.Path & "\VBTRACE.DAT")
  124.    FL = Err
  125.    On Error GoTo VBTraceError
  126.    If FL > 0 Or LineNumber = 0 Then
  127.       If FL = 0 Then
  128.          Kill app.Path & "\VBTRACE.DAT"
  129.       End If
  130.       OutRecord = "/*" & Now & ","
  131.       ReDim ProcedureNames(0)
  132.       I = False
  133.       LineNumber = False
  134.    End If
  135.    LineNumber = LineNumber + 1
  136.    
  137. '--GET ELASPSED TIME
  138.    ThisTime = CMS_TimeGetTime()
  139.    If PreviousTime(I) Then
  140.       If OpCode = 2 Then
  141.          ElapsedTime = Str$(ThisTime - PreviousTime(I))
  142.          CumTime(I) = CumTime(I) + Val(ElapsedTime)
  143.          CumlativeTime = Format$(CumTime(I))
  144.          TotalRunTime = TotalRunTime + Val(ElapsedTime)
  145.          TotalTime = Format$(TotalRunTime)
  146.          PercentTime(I) = CumTime(I) / TotalRunTime * 100
  147.          Percent = Format$(PercentTime(I))
  148.       End If
  149.    End If
  150.    
  151. '--ASSEMBLE COLUMN DATA
  152.    TraceGridVariable = "LineNumber"
  153.    OutRecord = OutRecord & "LineNumber," & LineNumber & ","
  154.    TraceGridVariable = "PreviousLine(I)"
  155.    OutRecord = OutRecord & "PreviousLine(I)," & PreviousLine(I) & ","
  156.    TraceGridVariable = "ElapsedTime"
  157.    OutRecord = OutRecord & "ElapsedTime," & ElapsedTime & ","
  158.    TraceGridVariable = "CumlativeTime"
  159.    OutRecord = OutRecord & "CumlativeTime," & CumlativeTime & ","
  160.    TraceGridVariable = "Percent"
  161.    OutRecord = OutRecord & "Percent," & Percent & ","
  162.    TraceGridVariable = "TotalTime"
  163.    OutRecord = OutRecord & "TotalTime," & TotalTime & ","
  164.    TraceGridVariable = "EntryCount(I)"
  165.    OutRecord = OutRecord & "EntryCount(I)," & EntryCount(I) & ","
  166.    TraceGridVariable = "ExitCount(I)"
  167.    OutRecord = OutRecord & "ExitCount(I)," & ExitCount(I) & ","
  168.    TraceGridVariable = "ProcedureName"
  169.    OutRecord = OutRecord & "ProcedureName," & ProcedureName & ","
  170.    OutRecord = OutRecord & "\,\,"
  171.    
  172. '--APPEND MEMORY VALUES TO RECORD
  173.    TraceGridVariable = "Available GDI Memory"
  174.    OutRecord = OutRecord & Format$(CMS_GetFreeSystemResources(GDI)) & ","
  175.    TraceGridVariable = "Available USER Memory"
  176.    OutRecord = OutRecord & Format$(CMS_GetFreeSystemResources(USR)) & ","
  177.    TraceGridVariable = "Available Global Heap Memory"
  178.    OutRecord = OutRecord & Format$(CMS_GetFreeSpace(0)) & ","
  179.       
  180. '--APPEND DISK SPACE TO RECORD
  181.    TraceGridVariable = "Available Disk Space"
  182.    OutRecord = OutRecord & Left$(app.Path, 1) & Format$(CMS_DiskSpaceFree()) & ","
  183.    
  184. '--APPEND FORMS COUNT TO RECORD
  185.    TraceGridVariable = "Forms Count"
  186.    OutRecord = OutRecord & Forms.Count & ","
  187.    
  188. '--APPEND PROCEDURE NAME TO RECORD
  189.    TraceGridVariable = ProcedureName
  190.    OutRecord = OutRecord & String$(MarginWidth, Padder) & ProcedureName & EntryExit(OpCode - 1)
  191.    TraceGridVariable = ""
  192.    
  193. '--APPEND PASSED VARIABLES TO RECORD
  194.  
  195. '--OPEN TRACE FILE, WRITE RECORD, AND CLOSE FILE
  196.    VBTraceFileNo = FreeFile
  197.    Open app.Path & "\VBTRACE.DAT" For Random Shared As VBTraceFileNo Len = TraceFileRecordLength
  198.       OutRecord = Left$(OutRecord & Space$(TraceFileRecordLength - 2), TraceFileRecordLength - 2)
  199.       Put #VBTraceFileNo, LineNumber, OutRecord
  200.       PreviousLine(I) = LineNumber
  201.       PreviousTime(I) = ThisTime
  202.       PreviousOpCode = OpCode
  203.       PreviousProcedure = ProcedureName
  204.   Close VBTraceFileNo
  205. Exit Sub
  206.    
  207. VBTraceError:
  208.    If Len(TraceGridVariable) Then
  209.       Msg = Error$ & " Referencing TraceGrid Variable '" & TraceGridVariable & "'.  "
  210.       Msg = Msg & "Disabling VBTrace."
  211.    End If
  212.    If Len(Msg) = 0 Then
  213.       Msg = Error$
  214.    End If
  215.    MsgBox Msg, IconStop, "VBTrace Error Handler"
  216.    Msg = ""
  217.    TraceOperationOffSwitch = True
  218.    Close VBTraceFileNo
  219.    If Len(Dir$(app.Path & "\VBTRACE.DAT")) Then
  220.       Close VBTraceFileNo
  221.       Kill app.Path & "\VBTRACE.DAT"
  222.    End If
  223.    Exit Sub
  224. End Sub
  225.  
  226.